home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / after.test next >
Encoding:
Text File  |  1995-06-21  |  4.4 KB  |  188 lines
  1. # This file is a Tcl script to test out Tk's "after" command.
  2. # It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) after.test 1.7 95/06/21 15:08:11
  11.  
  12. if {[string compare test [info procs test]] == 1} {
  13.     source defs
  14. }
  15.  
  16. test after-1.1 {after command} {
  17.     list [catch {after} msg] $msg
  18. } {1 {wrong # args: should be "after milliseconds ?command? ?arg arg ...?" or "after cancel id|command"}}
  19. test after-1.2 {after command} {
  20.     list [catch {after 2x} msg] $msg
  21. } {1 {expected integer but got "2x"}}
  22. test after-1.3 {after command} {
  23.     list [catch {after gorp} msg] $msg
  24. } {1 {bad argument "gorp": must be cancel, idle, or a number}}
  25. test after-1.4 {after command} {
  26.     set x before
  27.     after 400 {set x after}
  28.     after 200
  29.     update
  30.     set y $x
  31.     after 400
  32.     update
  33.     list $y $x
  34. } {before after}
  35. test after-1.5 {after command} {
  36.     set x before
  37.     after 300 set x after
  38.     after 200
  39.     update
  40.     set y $x
  41.     after 200
  42.     update
  43.     list $y $x
  44. } {before after}
  45.  
  46. test after-2.1 {cancel option} {
  47.     list [catch {after cancel} msg] $msg
  48. } {1 {wrong # args: should be "after cancel id|command"}}
  49. test after-2.2 {cancel option} {
  50.     list [catch {after cancel after#44x} msg] $msg
  51. } {1 {expected integer but got "44x"}}
  52. test after-2.3 {cancel option} {
  53.     after cancel after#1
  54. } {}
  55. test after-2.4 {cancel option} {
  56.     after cancel {foo bar}
  57. } {}
  58. test after-2.5 {cancel option} {
  59.     set x before
  60.     set y [after 100 set x after]
  61.     after cancel $y
  62.     after 200
  63.     update
  64.     set x
  65. } {before}
  66. test after-2.6 {cancel option} {
  67.     set x before
  68.     after 100 set x after
  69.     after cancel {set x after}
  70.     after 200
  71.     update
  72.     set x
  73. } {before}
  74. test after-2.7 {cancel option} {
  75.     set x before
  76.     after 100 set x after
  77.     after 300 set x after
  78.     after cancel {set x after}
  79.     after 200
  80.     update
  81.     set y $x
  82.     set x cleared
  83.     after 200
  84.     update
  85.     list $y $x
  86. } {after cleared}
  87. test after-2.8 {cancel option} {
  88.     set x first
  89.     after idle lappend x second
  90.     after idle lappend x third
  91.     set i [after idle lappend x fourth]
  92.     after cancel {lappend x second}
  93.     after cancel $i
  94.     update idletasks
  95.     set x
  96. } {first third}
  97. test after-2.9 {cancel option, multiple arguments for command} {
  98.     set x first
  99.     after idle lappend x second
  100.     after idle lappend x third
  101.     set i [after idle lappend x fourth]
  102.     after cancel lappend x second
  103.     after cancel $i
  104.     update idletasks
  105.     set x
  106. } {first third}
  107. test after-2.10 {cancel option, cancel during handler, used to dump core} {
  108.     set id [
  109.     after 100 {
  110.         set x done
  111.         after cancel $id
  112.     }
  113.     ]
  114.     tkwait variable x
  115. } {}
  116.  
  117. test after-3.1 {idle option} {
  118.     list [catch {after idle} msg] $msg
  119. } {1 {wrong # args: should be "after idle script script ..."}}
  120. test after-3.2 {idle option} {
  121.     set x before
  122.     after idle {set x after}
  123.     set y $x
  124.     update idletasks
  125.     list $y $x
  126. } {before after}
  127. test after-3.3 {idle option} {
  128.     set x before
  129.     after idle set x after
  130.     set y $x
  131.     update idletasks
  132.     list $y $x
  133. } {before after}
  134.  
  135. test after-4.1 {AfterProc procedure} {
  136.     set x before
  137.     proc foo {} {
  138.     set x untouched
  139.     after 100 {set x after}
  140.     after 200
  141.     update
  142.     return $x
  143.     }
  144.     list [foo] $x
  145. } {untouched after}
  146. test after-4.2 {AfterProc procedure} {
  147.     catch {rename tkerror {}}
  148.     proc tkerror msg {
  149.     global x errorInfo
  150.     set x [list $msg $errorInfo]
  151.     }
  152.     set x empty
  153.     after 100 {error "After error"}
  154.     after 200
  155.     set y $x
  156.     update
  157.     catch {rename tkerror {}}
  158.     list $y $x
  159. } {empty {{After error} {After error
  160.     while executing
  161. "error "After error""
  162.     ("after" script)}}}
  163.  
  164. if {[info commands testfevent] == "testfevent"} {
  165.     test after-5.1 {TkEventCleanupProc procedure} {
  166.     testfevent create
  167.     testfevent cmd {after 200 {
  168.         lappend x after
  169.         puts "test after-4.1, part 1: this message should not appear"
  170.     }}
  171.     after 200 {lappend x after2}
  172.     testfevent cmd {after 200 {
  173.         lappend x after3
  174.         puts "test after-4.1, part 2: this message should not appear"
  175.     }}
  176.     after 200 {lappend x after4}
  177.     testfevent cmd {after 200 {
  178.         lappend x after5
  179.         puts "test after-4.1, part 3: this message should not appear"
  180.     }}
  181.     testfevent delete
  182.     set x before
  183.     after 300
  184.     update
  185.     set x
  186.     } {before after2 after4}
  187. }
  188.